home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tests / tcllib.test < prev    next >
Encoding:
Text File  |  1994-01-23  |  9.6 KB  |  351 lines
  1. #
  2. # tcllib.test
  3. #
  4. # Tests for commands and functionallity involved in demand loadable Tcl
  5. # libraries.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: tcllib.test,v 3.2 1993/12/13 04:36:14 markd Exp $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] == ""} then {source testlib.tcl}
  21. eval $SAVED_UNKNOWN
  22.  
  23. # Load the slow-path part of the unknown command.  Otherwise the unknown
  24. # command will not work when the loadpath is changed.
  25.  
  26. if ![auto_load tclx_unknown2] {
  27.     error "can't auto_load tclx_unknown2"
  28. }
  29.  
  30. global save_auto_path auto_path
  31. set save_auto_path $auto_path
  32. set auto_path {}
  33. catch {unset auto_path}
  34.  
  35. if {[id user] == "root"} {
  36.     puts stderr "*************************************************************"
  37.     puts stderr "You are running as `root', certain tcllib tests will be"
  38.     puts stderr "skipped"
  39.     puts stderr "*************************************************************"
  40. }
  41.  
  42. #
  43. # Since we have libraries coming and going in this test, we need to
  44. # reset the environment.  
  45. #
  46. proc TclLibReset {} {
  47.     global auto_execs auto_index auto_pkg_index auto_path
  48.     catch {unset auto_execs}
  49.     catch {unset auto_index}
  50.     catch {unset auto_pkg_index}
  51.     
  52.     # This alters the internal knowledge of the last path that was loaded.
  53.     if [info exists auto_path] {
  54.         set save_auto_path $auto_path
  55.     } else {
  56.         set save_auto_path {}
  57.     }
  58.     set auto_path {}
  59.     auto_load
  60.     set auto_path $save_auto_path
  61. }
  62.  
  63. proc TclLibCleanUp {} {
  64.     catch {chmod +rwx tcllib1.dir}
  65.     catch {chmod +rwx tcllib2.dir}
  66.     unlink -nocomplain [glob -nocomplain tcllib1.dir/*]
  67.     unlink -nocomplain [glob -nocomplain tcllib2.dir/*]
  68.     catch {rmdir tcllib1.dir}
  69.     catch {rmdir tcllib2.dir}
  70.     TclLibReset
  71. }
  72.  
  73. TclLibCleanUp
  74.  
  75. proc PutFile {fileName args} {
  76.     set fp [open $fileName w]
  77.     foreach line $args {
  78.         puts $fp $line
  79.     }
  80.     close $fp
  81. }
  82.  
  83. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  84.  
  85. #
  86. # Test parameter checking for the basic commands that are implemented
  87. # in C.
  88. #
  89.  
  90. Test tcllib-1.1 {command parameter checking} {
  91.     auto_load a b c d
  92. } 1 {wrong # args: auto_load ?command?}
  93.  
  94. Test tcllib-1.2 {command parameter checking} {
  95.     loadlibindex
  96. } 1 {wrong # args: loadlibindex libFile}
  97.  
  98. Test tcllib-1.3 {command parameter checking} {
  99.     loadlibindex a b c d
  100. } 1 {wrong # args: loadlibindex libFile}
  101.  
  102. #
  103. # Test error recovery from bogus paths (should ignore path and not find proc)
  104. #
  105.  
  106. Test tcllib-2.1 {bogus path test} {
  107.     set auto_path [list /bogus/dir/path/no/work [pwd]/../tclmaster]
  108.     TclLibAAA
  109. } 1 {invalid command name "TclLibAAA"}
  110.  
  111. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  112.  
  113. Test tcllib-2.2 {bogus path test} {
  114.     set auto_path [list ~bogususerman/tcllib [pwd]/../tclmaster]
  115.     TclLibAAA
  116. } 1 {invalid command name "TclLibAAA"}
  117.  
  118. Test tcllib-2.3 {bogus path test} {
  119.     set auto_path [pwd]/../tclmaster
  120.     set auto_path [list /bogus/dir/path/no/work]
  121.     TclLibAAA
  122. } 1 {invalid command name "TclLibAAA"}
  123.  
  124.  
  125. #
  126. # Test error recovery from bogus package library indices.
  127. #
  128.  
  129. proc BuildTestLib {name {pbase TclLibAA}} {
  130.    PutFile $name \
  131.         "#@package: $name-package ${pbase}B ${pbase}C ${pbase}D" \
  132.         "proc ${pbase}B {} {return \"***${pbase}B***\"}" \
  133.         "proc ${pbase}C {} {return \"***${pbase}C***\"}" \
  134.         "proc ${pbase}D {} {return \"***${pbase}D***\"}" \
  135.         "#@packend"
  136. }
  137.  
  138. mkdir tcllib1.dir
  139. BuildTestLib tcllib1.dir/test1.tlib
  140. PutFile tcllib1.dir/test1.tndx {bogus
  141. data}
  142.  
  143. TclLibReset
  144. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  145.  
  146. TestReg tcllib-3.1 {bogus package library index} {
  147.     TclLibAAB
  148. } 1 {^format error in library index "/.*test1.tndx" \(bogus\)$}
  149.  
  150. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  151.  
  152. PutFile tcllib1.dir/test1.tndx \
  153.     {test1-package 56 240 TclLibAAB TclLibAAC TclLibAAD}
  154.  
  155. TestReg tcllib-3.2 {bogus package library index} {
  156.     TclLibAAB
  157. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  158.  
  159.  
  160. PutFile tcllib1.dir/test1.tndx \
  161.     {test1-package -1 140 TclLibAAB TclLibAAC TclLibAAD}
  162.  
  163. TestReg tcllib-3.3 {bogus package library index} {
  164.     TclLibAAB
  165. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  166.  
  167. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  168.  
  169. PutFile tcllib1.dir/test1.tndx \
  170.     {test1-package 156 40 TclLibAAB TclLibAAC TclLibAAD}
  171.  
  172. TestReg tcllib-3.4 {bogus package library index} {
  173.     TclLibAAB
  174. } 1 {^range to eval outside of file bounds "/}
  175.  
  176. TclLibReset
  177. set auto_path [list [pwd]/tcllib2.dir [pwd]/../tclmaster]
  178.  
  179. if {[id user] != "root"} {
  180.     Test tcllib-4.1 {bad rebuild package library index} {
  181.         global errorCode errorInfo
  182.         mkdir tcllib2.dir
  183.         BuildTestLib tcllib2.dir/test1.tlib TclLibAB
  184.         chmod -w tcllib2.dir
  185.         list [catch {TclLibABB} msg] [crange $msg 0 25] \
  186.              [lrange $errorCode 0 1] \
  187.              [string match "*while loading Tcl library index*" $errorInfo] \
  188.              [string match "*while auto loading \"TclLibABB\"*" $errorInfo]
  189.     } 0 {1 {building package index for} {POSIX EACCES} 1 1}
  190. }
  191.  
  192. TclLibCleanUp
  193. mkdir tcllib1.dir
  194. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  195.  
  196. PutFile tcllib1.dir/tclIndex "#" "badline" "nukearray nukearray.tmp" \
  197.     "baz baz.tmp"
  198.  
  199. Test tcllib-5.1 {bogus Ousterhout library index} {
  200.     set stat [catch nukearray msg]
  201.     if [string match "*/tclIndex isn't a proper Tcl index file" $msg] {
  202.         list $stat {IS OK}
  203.     } else {
  204.         list $stat $msg
  205.     }
  206. } 0 {1 {IS OK}}
  207.  
  208. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  209.         {set auto_index(parray)   " source $dir/parray.tcl"} \
  210.         {set auto_index(nukearray) "source $dir/spazzzzzzzz"} \
  211.  
  212. TestReg tcllib-5.2 {missing file found with Ousterhout library index} {
  213.     nukearray
  214. } 1 {^couldn't read file}
  215.  
  216. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {}}
  217. chmod 000 tcllib1.dir/nukearray.tmp
  218.  
  219. if {[id user] != "root"} {
  220.     TestReg tcllib-5.3 {missing file found with Ousterhout library index} {
  221.         nukearray
  222.     } 1 {^couldn't read file}
  223. }
  224.  
  225. TclLibCleanUp
  226. mkdir tcllib1.dir
  227.  
  228. BuildTestLib  tcllib1.dir/test2.tlib TclLibAC
  229. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  230.  
  231. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  232.         {set auto_index(parray)   " source $dir/parray.tcl"} \
  233.         {set auto_index(nukearray) "source $dir/nukearray.tmp"}
  234. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {return "@nukearray@"}}
  235.  
  236. Test tcllib-6.1 {successful library access} {
  237.     TclLibACB
  238. } 0 {***TclLibACB***}
  239.  
  240. Test tcllib-6.2 {successful library access} {
  241.     TclLibACB
  242. } 0 {***TclLibACB***}
  243.  
  244. Test tcllib-6.3 {successful library access} {
  245.     nukearray
  246. } 0 {@nukearray@}
  247.  
  248. #
  249. # Test skipping of duplicate packages.  Also make sure loadlibindex overrides
  250. # existing package definitions.  Test for both .tlib and tclIndex indexes.
  251. #
  252. TclLibCleanUp
  253. mkdir {tcllib1.dir tcllib2.dir}
  254. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  255.  
  256. PutFile tcllib1.dir/test1.tlib \
  257.     {#@package: test-pkg DupPkgTest} \
  258.     {proc DupPkgTest {} {return {Version-1}}
  259. }
  260. PutFile tcllib2.dir/test2.tlib \
  261.     {#@package: test-pkg DupPkgTest} \
  262.     {proc DupPkgTest {} {return {Version-2}}
  263. }
  264.  
  265. Test tcllib-7.1 {Duplicate package handling} {
  266.     DupPkgTest
  267. } 0 {Version-1}
  268.  
  269. TclLibReset
  270. rename DupPkgTest {}
  271.  
  272. Test tcllib-7.2 {Duplicate package handling} {
  273.     lrmdups {a b c}  ;# Force load of indices.
  274.     loadlibindex tcllib2.dir/test2.tlib
  275.     DupPkgTest
  276. } 0 {Version-2}
  277.  
  278. TclLibCleanUp
  279. rename DupPkgTest {}
  280. mkdir {tcllib1.dir tcllib2.dir}
  281. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  282.  
  283. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  284.         {set auto_index(DupPkgTest)  " source $dir/test1.tcl"}
  285.  
  286. PutFile tcllib1.dir/test1.tcl \
  287.     {proc DupPkgTest {} {return {Version-1}}
  288. }
  289.  
  290. PutFile tcllib2.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  291.         {set auto_index(DupPkgTest)  " source $dir/test1.tcl"}
  292.  
  293. PutFile tcllib2.dir/test1.tcl \
  294.     {proc DupPkgTest {} {return {Version-2}}
  295. }
  296.  
  297. Test tcllib-7.3 {Duplicate package handling} {
  298.     DupPkgTest
  299. } 0 {Version-1}
  300.  
  301. TclLibReset
  302. rename DupPkgTest {}
  303.  
  304. Test tcllib-7.4 {Duplicate package handling} {
  305.     lrmdups {a b c}  ;# Force load of indices.
  306.     loadlibindex tcllib2.dir/tclIndex
  307.     DupPkgTest
  308. } 0 {Version-2}
  309.  
  310.  
  311. #
  312. # Test backslash parsing in #@package: line.
  313. #
  314. TclLibCleanUp
  315. mkdir {tcllib1.dir tcllib2.dir}
  316. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  317.  
  318. PutFile tcllib1.dir/test1.tlib \
  319.     {#@package: test-pkg procAAA \\} \
  320.     {           procBBB \\         } \
  321.     {           procCCC            } \
  322.     {proc procAAA {} {return {AAA}}} \
  323.     {proc procBBB {} {return {BBB}}} \
  324.     {proc procCCC {} {return {CCC}}}
  325.  
  326. Test tcllib-8.1 {backslash parsing in package headers} {
  327.     TclLibReset
  328.     procAAA
  329. } 0 {AAA}
  330.  
  331.  
  332. Test tcllib-8.2 {backslash parsing in package headers} {
  333.     TclLibReset
  334.     procBBB
  335. } 0 {BBB}
  336.  
  337.  
  338. Test tcllib-8.3 {backslash parsing in package headers} {
  339.     TclLibReset
  340.     procCCC
  341. } 0 {CCC}
  342.  
  343. TclLibCleanUp
  344.  
  345. rename TclLibCleanUp {}
  346. rename PutFile {}
  347. rename TclLibReset {}
  348.  
  349. set auto_path $save_auto_path
  350. rename unknown {}
  351.